perm filename POX.SAI[PIX,HPM] blob
sn#013234 filedate 1972-11-18 generic text, type T, neo UTF8
00100 BEGIN "PIX"
00200
00300 REQUIRE "HELIB[1,3]" LIBRARY;
00400 REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00500 REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
00600 REQUIRE 2000 STRING_SPACE;
00700 REQUIRE "⊂⊃||" DELIMITERS;
00800
00900 DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, PRO=⊂PROCEDURE⊃,
01000 CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂(BUF+1) LAND '777777⊃, REF=⊂REFERENCE⊃,
01100 RED=⊂0⊃, BLUE=⊂1⊃, GREEN=⊂2⊃, CLEAR=⊂3⊃;
01200 EXT PRO PICINI(INTEGER CHAN, FILE, EXTEN, PPN;REF BOOLEAN FAIL;INTEGER ARRAY STOR);
01300 EXT PRO PICRD(REF BOOLEAN FAIL; INTEGER ARRAY STOR);
01400 EXT PRO PICWR(INTEGER CHAN, FILE, EXTEN, PPN; REF BOOLEAN FAIL; INTEGER ARRAY STOR);
01500 EXT PRO RELCOR(INTEGER IOWD);
01600 EXT INTEGER PRO GETCOR(INTEGER SIZE);
01700 EXT PRO INP;
01800 EXT INTEGER PRO GIOWD(INTEGER ARRAY BUF);
01900 EXT PRO EYECAL(INTEGER SIZE, FRAM, FLAG; INTEGER ARRAY BUF);
02000 EXT PRO CWHEEL(INTEGER CODE);
02100 EXT PRO TVIN;
02200 EXT PRO PRDUMP;
02300 EXT PRO PORTR;
02400 EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
02500 EXTERNAL PROCEDURE CALLEN;
02600 EXTERNAL PROCEDURE SPWOFF;
02700 EXT INTEGER TVWORD, FLINE, LLINE, RSIDE, LSIDE, TCLIP, BCLIP, PRTBUF,
02800 L1, L2, L3, P1,P2,P3,STATUS,TSERVO,LENS,TVCAM;
02900
03000 SAFE INTEGER ARRAY PNTRS[1:25];
03100 SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
03200 MART,SWING,FOC,FOCLEN0,FOCLENG[1:4],DP,P0[1:4,1:3],PP[1:4,1:2];
03300 INTEGER N, LIN, I, II, III, ANS, TVLENG;
03400 REAL PANPOT, FOCPOT, TILPOT;
03500 LABEL RUSE, LOOP;
03600 STRING STR, INS;
03700 PRELOAD_WITH "R","B","G"; STRING ARRAY CFIRST[1:3];
03702 PRELOAD_WITH "I","$","C"; STRING ARRAY CBEG[1:3];
03800 SAFE INTEGER ARRAY PICALLOC[1:3]; α allocation table for data blocks;
03900 α first we initialize the world;
04000 QUICK_CODE '051000000000 '10,0; END;
04100 INS ← INCHWL;
04200 CLRBUF;
04300 OUTSTR(CRLF&"TYPE ALTMODE TO CHANGE CHANNEL"&CRLF&CRLF&
04400 "TYPE SPACE TO TAKE A PICTURE"&CRLF&CRLF&
04500 "FOR CHAN 51 (THE OLD HAND EYE CAMERA)"&CRLF&
04600 "YOU MAY ALSO TYPE"&CRLF&
04700 " C - TO TAKE A COLOR PICTURE (THREE FILES)"&CRLF&
04800 " R - TO TAKE A PICTURE THROUGH THE RED FILTER"&CRLF&
04900 " B - TO TAKE A BLUE PICTURE"&CRLF&
05000 " G - TO TAKE A GREEN PICTURE"&CRLF);
05100 WHILE LENGTH(INS) ≥ 2 ∧ INS[1 TO 1] ≠ ";" DO INS ← INS[2 TO ∞];
05200 LIN ← IF INS[1 TO 1]=";" THEN CVO(INS[2 TO ∞]) ELSE '15;
05300 LOOP: TVCAM ← IF (LIN LAND 7) = 1 THEN 1 ELSE
05400 IF (LIN LAND 7) = 2 THEN 2 ELSE
05500 IF (LIN LAND 7) = 0 THEN 0 ELSE 3;
05600 START_CODE
05700 LABEL XX1,GOO;
05800 JRST GOO;
05900 XX1: '401401000000 LIN;
06000 GOO: MOVE 1,XX1;
06100 CALLI 1,'400070;
06200 SKIP 0;
06300 END;
06400 TCLIP ← 0;
06500 BCLIP ← 7;
06600 PICALLOC[1] ← PICALLOC[2] ← PICALLOC[3] ← PNTRS[1] ← 0;
06700 ARRBLT(PNTRS[2],PNTRS[1],24);
06800 FLINE←'13;
06900 LLINE←'373;
07000 RSIDE←'512;
07100 LSIDE←'13;
07200 TVLENG ← ((RSIDE-LSIDE)/9+1)*(LLINE-FLINE+1);
07300 PICALLOC[1] ← GETCOR(TVLENG);
07400 IF TVCAM = 1 THEN
07500 BEGIN
07600 PICALLOC[2]←GETCOR(TVLENG);
07700 PICALLOC[3]←GETCOR(TVLENG);
07800 END;
07900 OUTSTR("*");
08000 IF (I ← INCHRW) = '175 THEN
08100 BEGIN
08200 OUTSTR("CHANNEL=");
08300 LIN←CVO(INCHWL);
08400 GO TO RUSE;
08500 END;
08600 I ← IF I > '140 ∧ I < '173 THEN I - '40 ELSE I;
08700 II ← IF I = '103 THEN RED ELSE
08800 IF I = '102 THEN BLUE ELSE
08900 IF I = '107 THEN GREEN ELSE
09000 IF I = '122 THEN RED ELSE CLEAR;
09100 III ← IF I = '103 ∧ TVCAM = 1 THEN GREEN ELSE II;
09200 N ← 0;
09300 FOR I ← II STEP 1 UNTIL III DO
09400 BEGIN EXTERNAL INTEGER IND;
09500 IF TVCAM = 1 THEN
09600 BEGIN
09700 CWHEEL(6);
09800 IF IND ≠ I THEN
09900 BEGIN INTEGER M;
10000 CWHEEL(I);
10100 M ← 12000;
10200 WHILE M ← M - 1 DO;
10300 END;
10400 END;
10500 TVWORD ← PICALLOC[N ← N + 1];
10600 TVIN;
10700 END;
10800 BEGIN "DSKOUT"
10900 INTEGER FILE, PPN, EXTEN, FAIL;
11000 STRING FILOUT;
11100 LABEL LOOP3;
11200 LOOP3: OUTSTR("FILE NAME=");
11300 STR ← INCHWL;
11400 IF LENGTH(STR)≠0 THEN
11500 FOR I ← 1 STEP 1 UNTIL III-II+1 DO
11600 BEGIN
11700 PNTRS[1]←PICALLOC[I];
11800 FILOUT←IF II=III THEN STR ELSE CFIRST[I]&STR;
11900 FILE←CVFIL(FILOUT,EXTEN,PPN);
12000 PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
12100 IF FAIL THEN BEGIN USERERR(0,0,"WRITING OF FILE "
12200 &FILOUT&" FAILED"); GO TO LOOP3;END;
12300 OUTSTR("FILE "&FILOUT&" WRITTEN OUT"&CRLF);
12400 END;
12500 IF II≠III THEN
12600 BEGIN
12650 OUTSTR(" IN"&CRLF);
12700 BEGIN "RGB2IC"
12800 INTEGER SIZX,SIZY,SIZL,PT1,OPT1,PT2,OPT2,PT3,OPT3,XPT2,
12900 HINT,INT,INT1,INT2,PT,LIN,R,G,B,R1,R2,G1,G2,B1,B2,X,Y;
13000
13100 SIZX←RSIDE-LSIDE+1; SIZY←LLINE-FLINE+1; SIZL←(RSIDE-LSIDE)/9+1;
13150 OUTSTR("SIZX "&CVS(SIZX)&" SIZY "&CVS(SIZY)&" SIZL "&CVS(SIZL)&CRLF);
13200 OPT1←'400000000 LOR (PICALLOC[1] LAND '777777);
13250 OPT2←'400000000 LOR (PICALLOC[3] LAND '777777);
13300 OPT3←'400000000 LOR (PICALLOC[2] LAND '777777);
13350 OUTSTR(" OPT1 "&CVOS(OPT1)&" OPT2 "&CVOS(OPT2)&" OPT3 "&CVOS(OPT3)&CRLF);
13400 HINT←1 LSH (4-1);
13500 FOR LIN←1 STEP 1 UNTIL SIZY DO
13600 BEGIN PT1←OPT1; PT2←OPT2; PT3←OPT3;
13700 FOR PT←1 STEP 2 UNTIL SIZX DO
13800 BEGIN R1←ILDB(PT1); G1←ILDB(PT2); B1←ILDB(PT3);
13900 INT1←R1+G1+B1;
14000 DPB(INT1 DIV 3,PT1);
14100 XPT2←PT2;
14200 R2←ILDB(PT1); G2←ILDB(PT2); B2←ILDB(PT3);
14300 INT2←R2+G2+B2;
14400 DPB(INT2 DIV 3,PT1);
14500 R←R1+R2; G←G1+G2; INT←INT1+INT2;
14600 X←(3*R-INT) DIV 6 + HINT;
14700 Y←(3*G-INT) DIV 6 + HINT;
14800 DPB(X,XPT2); DPB(Y,PT2);
14900 END;
15000 OPT1←OPT1+SIZL; OPT2←OPT2+SIZL; OPT3←OPT3+SIZL;
15100 END;
15125 OUTSTR(" AND OUT"&CRLF);
15150 END "RGB2IC";
15200 FOR I←1 STEP 2 UNTIL 3 DO
15300 BEGIN
15400 PNTRS[1]←PICALLOC[I];
15500 FILOUT←CBEG[I]&STR;
15600 FILE←CVFIL(FILOUT,EXTEN,PPN);
15700 PICWR(1,FILE,EXTEN,PPN,FAIL,PNTRS);
15800 IF FAIL THEN BEGIN USERERR(0,0,"WRITING OF FILE "
15900 &FILOUT&" FAILED"); GO TO LOOP3;END;
16000 OUTSTR("FILE "&FILOUT&" WRITTEN OUT"&CRLF);
16100 END;
16102 END;
16200 END "DSKOUT";
16300 α return for next picture;
16400
16500 RUSE: FOR I ← 1 STEP 1 UNTIL 3 DO
16600 BEGIN
16700 IF PICALLOC[I] THEN RELCOR(PICALLOC[I]);
16800 PICALLOC[I] ← PNTRS[I] ← 0;
16900 END;
17000 GO TO LOOP;
17100 END;